home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / FGL402F.ZIP / EXFOR.ARJ / TEMP / 08-14.FOR < prev    next >
Text File  |  1995-01-20  |  2KB  |  71 lines
  1. $INCLUDE: 'C:\FG\FASTGRAF.FI'
  2.  
  3. C  This program will work with Microsoft FORTRAN 4.x/5.x only.  For a
  4. C  Microsoft FORTRAN PowerStation version of this program, see the file
  5. C  08-14PS.FOR.
  6.  
  7.       PROGRAM MAIN
  8.  
  9.       INTEGER WIDTH, HEIGHT
  10.       PARAMETER (WIDTH = 640, HEIGHT = 400)
  11.  
  12.       INTEGER HANDLE, OLD_MODE, STATUS
  13.       INTEGER FG_GETMODE, FG_VBALLOC, FG_VBOPEN
  14.  
  15. C  Initialize the video environment
  16.  
  17.       CALL FG_INITPM
  18.       OLD_MODE = FG_GETMODE()
  19.       CALL FG_SETMODE(19)
  20.       CALL FG_VBINIT
  21.  
  22. C  Set up a 640x400 virtual buffer
  23.  
  24.       HANDLE = FG_VBALLOC(WIDTH,HEIGHT)
  25.       IF (HANDLE .LT. 0) THEN
  26.          CALL FG_SETMODE(OLD_MODE)
  27.          CALL FG_RESET
  28.          STOP 'Could not create the virtual buffer.'
  29.       END IF
  30.       STATUS = FG_VBOPEN(HANDLE)
  31.  
  32. C  Draw a 320x200 rectangle in each virtual buffer quadrant
  33.  
  34.       CALL FG_SETCOLOR(9)
  35.       CALL FG_RECT(0,319,0,199)
  36.       CALL FG_SETCOLOR(10)
  37.       CALL FG_RECT(320,639,0,199)
  38.       CALL FG_SETCOLOR(11)
  39.       CALL FG_RECT(0,319,200,399)
  40.       CALL FG_SETCOLOR(12)
  41.       CALL FG_RECT(320,639,200,399)
  42.  
  43. C  Paste each rectangle to the 320x200 active video page
  44.  
  45.       CALL FG_VBPASTE(0,319,0,199,0,199)
  46.       CALL FG_WAITKEY
  47.       CALL FG_VBPASTE(320,639,0,199,0,199)
  48.       CALL FG_WAITKEY
  49.       CALL FG_VBPASTE(0,319,200,399,0,199)
  50.       CALL FG_WAITKEY
  51.       CALL FG_VBPASTE(320,639,200,399,0,199)
  52.       CALL FG_WAITKEY
  53.  
  54. C  Paste the center 320x200 subset of the virtual buffer
  55.  
  56.       CALL FG_VBPASTE(160,479,100,299,0,199)
  57.       CALL FG_WAITKEY
  58.  
  59. C  Close the virtual buffer
  60.  
  61.       CALL FG_VBCLOSE
  62.       CALL FG_VBFREE(HANDLE)
  63.  
  64. C  Restore original video mode and exit
  65.  
  66.       CALL FG_SETMODE(OLD_MODE)
  67.       CALL FG_RESET
  68.  
  69.       STOP ' '
  70.       END
  71.